home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / markelems.mod (.txt) < prev    next >
Oberon Text  |  1996-03-19  |  7KB  |  201 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 14 Feb 96
  5. Syntax10b.Scn.Fnt
  6. Syntax10i.Scn.Fnt
  7. MODULE MarkElems;  (** HM 
  8. IMPORT Files, Fonts, Display, Input, Viewers, Texts, TextFrames, TextPrinter, MenuViewers, Oberon;
  9. CONST
  10.     middle = 1; right = 0;
  11.     pixel = LONG(10000);
  12.     Elem* = POINTER TO ElemDesc;
  13.     ElemDesc* = RECORD (Texts.ElemDesc)
  14.         key*: LONGINT
  15.     END ;
  16.     Frame = POINTER TO FrameDesc;
  17.     FrameDesc = RECORD (TextFrames.FrameDesc)
  18.         e: Elem
  19.     END ;
  20.     backF*: TextFrames.Frame;    (**source frame of most recent link*)
  21.     backE*: Texts.Elem;    (**most recently activated link elem*)
  22.     icon, invIcon: Display.Pattern; (* x = 0, y = 3, w = 12, h = 8 *)
  23.     w: Texts.Writer;
  24. PROCEDURE ShowKey (e: Elem);
  25.     VAR t: Texts.Text; v: MenuViewers.Viewer; f: Frame; x, y: INTEGER;
  26. BEGIN
  27.     t := TextFrames.Text(""); Texts.WriteInt(w, e.key, 0); Texts.Append(t, w.buf);
  28.     NEW(f); f.e := e; TextFrames.Open(f, t, 0);
  29.     Oberon.AllocateSystemViewer(0, x, y);
  30.     v := MenuViewers.New(
  31.         TextFrames.NewMenu("MarkElem", "System.Close  MarkElems.Update "),
  32.         f, TextFrames.menuH, x, y)
  33. END ShowKey;
  34. PROCEDURE ShowPos (f: TextFrames.Frame; pos: LONGINT);
  35.     VAR beg, end, delta: LONGINT;
  36. BEGIN delta := 200;
  37.     LOOP beg := f.org; end := TextFrames.Pos(f, f.X + f.W, f.Y);
  38.         IF (beg <= pos) & (pos < end) OR (delta = 0) THEN EXIT END ;
  39.         TextFrames.Show(f, pos - delta); delta := delta DIV 2
  40. END ShowPos;
  41. PROCEDURE GoBack;
  42.     VAR r: Texts.Reader; pos: LONGINT;
  43. BEGIN
  44.     IF backF # NIL THEN
  45.         Texts.OpenReader(r, backF.text, 0);
  46.         LOOP Texts.ReadElem(r);
  47.             IF r.eot THEN EXIT END ;
  48.             IF r.elem = backE THEN
  49.                 pos := Texts.Pos(r); ShowPos(backF, pos); TextFrames.SetSelection(backF, pos-1, pos);
  50.                 backF := NIL; EXIT
  51.             END
  52.         END
  53. END GoBack;
  54. PROCEDURE GetDsr (f: Display.Frame; pos: LONGINT; fnt: Fonts.Font; VAR dsr: INTEGER);
  55.     VAR p: TextFrames.Parc; beg: LONGINT;
  56. BEGIN
  57.     IF f = NIL THEN
  58.         IF fnt = NIL THEN dsr := 0 ELSE dsr := - fnt.minY END
  59.     ELSE
  60.         TextFrames.ParcBefore(f(TextFrames.Frame).text, pos, p, beg);
  61.         dsr := SHORT(p.dsr DIV TextFrames.Unit)
  62. END GetDsr;
  63. PROCEDURE Handle* (e: Texts.Elem; VAR m: Texts.ElemMsg);
  64.     VAR e1: Elem; x, y, dsr: INTEGER; keys: SET;
  65. BEGIN
  66.     WITH e: Elem DO
  67.         WITH m: Texts.FileMsg DO
  68.             IF m.id = Texts.load THEN Files.ReadLInt(m.r, e.key)
  69.             ELSE (*Texts.store*) Files.WriteLInt(m.r, e.key)
  70.             END
  71.         | m: Texts.CopyMsg DO
  72.             IF m.e = NIL THEN NEW(e1); m.e := e1 ELSE e1 := m.e(Elem) END ;
  73.             e1.key := e.key; Texts.CopyElem(e, e1)
  74.         | m: Texts.IdentifyMsg DO
  75.             m.mod := "MarkElems"; m.proc := "Alloc"
  76.         | m: TextFrames.DisplayMsg DO
  77.             IF ~m.prepare THEN
  78.                 GetDsr(m.frame, m.pos, m.fnt, dsr);
  79.                 Display.CopyPattern(Display.white, icon, m.X0, m.Y0+dsr, Display.paint)
  80.             ELSE
  81.                 e.W := 12 * pixel; e.H := 11 * pixel
  82.             END
  83.         | m: TextPrinter.PrintMsg DO
  84.             IF m.prepare THEN e.W := 1 ELSE e.W := 12 * pixel END
  85.         | m: TextFrames.TrackMsg DO
  86.                 IF middle IN m.keys THEN
  87.                     GetDsr(m.frame, m.pos, m.fnt, dsr);
  88.                     Display.CopyPattern(Display.white, icon, m.X0, m.Y0+dsr, Display.invert);
  89.                     Display.CopyPattern(Display.white, invIcon, m.X0, m.Y0+dsr, Display.invert);
  90.                     REPEAT Input.Mouse(keys, x, y); m.keys := m.keys + keys;
  91.                         Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  92.                     UNTIL keys = {};
  93.                     Display.CopyPattern(Display.white, invIcon, m.X0, m.Y0+dsr, Display.invert);
  94.                     Display.CopyPattern(Display.white, icon, m.X0, m.Y0+dsr, Display.invert);
  95.                     IF m.keys = {middle} THEN GoBack
  96.                     ELSIF m.keys = {middle, right} THEN ShowKey(e)
  97.                     END
  98.                 END
  99.         ELSE
  100.         END
  101. END Handle;
  102. PROCEDURE New* (): Elem;
  103.     VAR e: Elem;
  104. BEGIN
  105.     NEW(e); e.W := 12 * pixel; e.H := 11 * pixel; e.handle := Handle; e.key := Oberon.Time(); RETURN e
  106. END New;
  107. PROCEDURE MarkProcs*;
  108.     VAR v: Viewers.Viewer; t: Texts.Text; s: Texts.Scanner; pos: LONGINT; ch: CHAR; key: LONGINT; mark: Elem;
  109. BEGIN
  110.     v := Oberon.MarkedViewer();
  111.     IF v.dsc.next IS TextFrames.Frame THEN
  112.         t := v.dsc.next(TextFrames.Frame).text;
  113.         Texts.OpenScanner(s, t, 0); Texts.Scan(s); key := Oberon.Time();
  114.         WHILE ~ s.eot DO
  115.             IF (s.class = Texts.Name) & (s.s = "PROCEDURE") THEN
  116.                 pos := Texts.Pos(s);
  117.                 Texts.Scan(s);
  118.                 IF s.class = Texts.Char THEN
  119.                     IF (s.c = "^") OR (s.c = "*") OR (s.c = "-") THEN pos := Texts.Pos(s); Texts.Scan(s)
  120.                     ELSIF s.c = "(" THEN
  121.                         REPEAT Texts.Scan(s) UNTIL (s.class = Texts.Char) & (s.c = ")") OR s.eot;
  122.                         pos := Texts.Pos(s); Texts.Scan(s)
  123.                     END
  124.                 END ;
  125.                 IF s.class = Texts.Name THEN
  126.                     Texts.OpenReader(s, t, pos); Texts.Read(s, ch);
  127.                     IF (s.elem = NIL) OR ~(s.elem IS Elem) THEN
  128.                         mark := New(); mark.key := key; INC(key);
  129.                         Texts.WriteElem(w, mark); Texts.Insert(t, pos, w.buf)
  130.                     END ;
  131.                     Texts.OpenScanner(s, t, pos+1)
  132.                 END
  133.             END ;
  134.             Texts.Scan(s)
  135.         END
  136. END MarkProcs;
  137. PROCEDURE ShowNext*;
  138.     VAR f: Display.Frame; tf: TextFrames.Frame; pos: LONGINT; r: Texts.Reader;
  139. BEGIN
  140.     IF Oberon.FocusViewer # NIL THEN
  141.         f := Oberon.FocusViewer.dsc.next;
  142.         IF (f # NIL) & (f IS TextFrames.Frame) THEN
  143.             tf := f(TextFrames.Frame);
  144.             IF tf.hasCar THEN pos := tf.carloc.pos ELSE pos := 0 END ;
  145.             Texts.OpenReader(r, tf.text, pos); Texts.ReadElem(r);
  146.             WHILE ~r.eot & ~(r.elem IS Elem) DO Texts.ReadElem(r) END ;
  147.             IF r.eot THEN TextFrames.RemoveCaret(tf)
  148.             ELSE pos := Texts.Pos(r); ShowPos(tf, pos); TextFrames.SetCaret(tf, pos)
  149.             END
  150.         END
  151. END ShowNext;
  152. PROCEDURE Alloc*;
  153.     VAR e: Elem;
  154. BEGIN
  155.     NEW(e); e.handle := Handle; Texts.new := e
  156. END Alloc;
  157. PROCEDURE Update*;
  158.     VAR f: Frame; t: Texts.Text; s: Texts.Scanner; r: Texts.Reader; ch: CHAR;
  159. BEGIN
  160.     IF (Oberon.Par.frame = Oberon.Par.vwr.dsc) & (Oberon.Par.frame.next IS Frame) THEN
  161.         f := Oberon.Par.frame.next(Frame);
  162.         Texts.OpenScanner(s, f.text, 0); Texts.Scan(s);
  163.         IF s.class = Texts.Int THEN
  164.             f.e.key := s.i;
  165.             t := Oberon.Par.frame(TextFrames.Frame).text;
  166.             Texts.OpenReader(r, t, t.len-1); Texts.Read(r, ch);
  167.             IF ch = "!" THEN Texts.Delete(t, t.len-1, t.len) END
  168.         END
  169. END Update;
  170. PROCEDURE Insert*;
  171.     VAR m: TextFrames.InsertElemMsg;
  172. BEGIN
  173.     m.e := New(); Viewers.Broadcast(m)
  174. END Insert;
  175. PROCEDURE InitIcon;
  176.     VAR line: ARRAY 9 OF SET;
  177. BEGIN
  178.     line[1] := {4..7};
  179.     line[2] := {3, 8};
  180.     line[3] := {2, 9};
  181.     line[4] := {2, 5, 6, 9};
  182.     line[5] := {2, 5, 6, 9};
  183.     line[6] := {2, 9};
  184.     line[7] := {3, 8};
  185.     line[8] := {4..7};
  186.     icon := Display.NewPattern(line, 12, 8);
  187.     line[1] := {};
  188.     line[2] := {4..7};
  189.     line[3] := {3..8};
  190.     line[4] := {3, 4, 7, 8};
  191.     line[5] := {3, 4, 7, 8};
  192.     line[6] := {3..8};
  193.     line[7] := {4..7};
  194.     line[8] := {};
  195.     invIcon := Display.NewPattern(line, 12, 8)
  196. END InitIcon;
  197. BEGIN
  198.     Texts.OpenWriter(w); backF := NIL;
  199.     InitIcon
  200. END MarkElems.
  201.